home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 5 / BBS in a Box -Volume V (BBS in a Box) (April 1992).iso / Files / Prog / B-C / CTherm.cpt / TestThermometer.p < prev    next >
Encoding:
Text File  |  1990-09-01  |  9.7 KB  |  332 lines  |  [TEXT/PJMM]
  1. {****************************************************}
  2. {}
  3. {         TestTherm.p    }
  4. {        A small program to demonstrate CThermometer    }
  5. {            WARNING: Don't use this program as a example of good programming    }
  6. {            practice, it's a hack    }
  7. {        Copyright © 1990, Captain Mac Enterprises.  All rights reserved.    }
  8. {        8/23/90    }
  9. {}
  10. {****************************************************}
  11. program TestTherm;
  12.     uses
  13.         Script, MiniIntf, CThermometer;
  14.     const
  15.         quitItem = 1;
  16.         barItem = 2;
  17.         pieItem = 3;
  18.         incrItem = 4;
  19.         menuItem = 5;
  20.         durationItem = 9;
  21.         ckBoxTicks = 10;
  22.         aboutItem = 11;
  23.         ckBoxUseMsg = 12;
  24.         msgItem = 13;
  25.  
  26.         menuID = 1000;
  27.  
  28.         loopStart = 1;
  29.  
  30.  
  31.     var
  32.         gFillPat: Pattern;
  33.         gIncrement, gLoopEnd: Integer;
  34.         gUseTicks, gUseMsg: Boolean;
  35.         gMsg: Str255;
  36.  
  37.  
  38.     procedure DoCBarTherm (msg: Str255);
  39.         var
  40.             i: Integer;
  41.             aThermometer: CBarTherm;
  42.     begin
  43.         New(aThermometer);        {create the object}
  44.         aThermometer.IThermometer(msg, gIncrement, gFillPat, gUseTicks);    {init therm}
  45.         for i := loopStart to gLoopEnd do        {get something to indicate}
  46.             if aThermometer.AdjThermometer(Round(i / gLoopEnd * 100)) then    {send a % and check for cancel or end of loop}
  47.                 Leave;
  48.         aThermometer.Free;        {get rid of the object}
  49.     end;
  50.  
  51.  
  52.     procedure DoCPieTherm (msg: Str255);
  53.         var
  54.             i: Integer;
  55.             aThermometer: CPieTherm;
  56.     begin
  57.         New(aThermometer);        {create the object}
  58.         aThermometer.IThermometer(msg, gIncrement, gFillPat, gUseTicks);    {init therm}
  59.         for i := loopStart to gLoopEnd do        {get something to indicate}
  60.             if aThermometer.AdjThermometer(Round(i / gLoopEnd * 100)) then    {send a % and check for cancel or end of loop}
  61.                 Leave;
  62.         aThermometer.Free;        {get rid of the object}
  63.     end;
  64.  
  65.  
  66.     procedure CenterWindow (theWindow: WindowPtr);
  67.         var
  68.             h, v: Integer;
  69.     begin        {CenterWindow}
  70.         with theWindow^, portRect do
  71.             begin
  72.                 h := (screenBits.bounds.right - screenBits.bounds.left) div 2 - (right - left) div 2;
  73.                 v := GetMBarHeight div 2 + (screenBits.bounds.bottom - screenBits.bounds.top) div 2 - (bottom - top) div 2;
  74.             end;
  75.         MoveWindow(theWindow, h, v, True);
  76.     end;        {CenterWindow}
  77.  
  78.  
  79.     procedure DoCheckBox (theDialog: dialogPtr; theCkBox: Integer);        {handle check box}
  80.         var
  81.             itemKind: Integer;
  82.             itemHandle: Handle;
  83.             itemRect: Rect;
  84.             p: Point;
  85.     begin        {DoCheckBox}
  86.         GetMouse(p);
  87.         GetDItem(theDialog, theCkBox, itemKind, itemHandle, itemRect);
  88.         if (TrackControl(ControlHandle(itemHandle), p, nil) = inCheckBox) & (itemKind = chkCtrl + ctrlItem) then
  89.             SetCtlValue(ControlHandle(itemHandle), 1 - GetCtlValue(ControlHandle(itemHandle)));        {set new control value}
  90.     end;        {DoCheckBox}
  91.  
  92.  
  93.     procedure DoPopUp (theDialog: DialogPtr; dlgItem: Integer);  {popup menu for arrowheads}
  94.         const
  95.             patWhite = 1;
  96.             patLtGray = 2;
  97.             patGray = 3;
  98.             patDkGray = 4;
  99.             patBlack = 5;
  100.             mTitleItem = 7;
  101.         var
  102.             savePort: GrafPtr;
  103.             itemHandle: Handle;
  104.             itemRect: Rect;
  105.             theChoice: Longint;
  106.             menuItem, prevPopItem, i, itemKind: Integer;
  107.             popUpMenuH: MenuHandle;  {these popups will be created on the fly}
  108.             p: Point;
  109.             patStr, itemStr: Str255;
  110.     begin  {DoPopUp}
  111.         GetPort(savePort);
  112.         SetPort(theDialog);
  113.         popUpMenuH := GetMenu(menuID);  {load the menu}
  114.         GetDItem(theDialog, dlgItem, itemKind, itemHandle, itemRect);  {get item clicked in}
  115.         GetIText(itemHandle, patStr);
  116.         for i := 1 to CountMItems(popUpMenuH) do
  117.             begin
  118.                 GetItem(popUpMenuH, i, itemStr);
  119.                 if itemStr = patStr then
  120.                     prevPopItem := i;
  121.             end;
  122.         GetDItem(theDialog, mTitleItem, itemKind, itemHandle, itemRect);  {get item clicked in}
  123.         SetPt(p, itemRect.left + (itemRect.right - itemRect.left) + 4, itemRect.top);  {offset where menu will appear}
  124.         LocalToGlobal(p);  {convert to global for menu manager}
  125.         for i := 1 to CountMItems(popUpMenuH) do
  126.             CheckItem(popUpMenuH, i, False);  {uncheck all items}
  127.         CheckItem(popUpMenuH, prevPopItem, True);
  128.         InvertRect(itemRect);  {invert item}
  129.         InsertMenu(popUpMenuH, -1);  {bring up menu as heir}
  130.         theChoice := PopUpMenuSelect(popUpMenuH, p.v, p.h, prevPopItem);  {bring up menu}
  131.         menuItem := LoWord(theChoice);  {get the number of the menu item chosen}
  132.         if menuItem = 0 then  {user chose nothing}
  133.             InvertRect(itemRect)
  134.         else
  135.             begin  {process menu choice}
  136.                 InvertRect(itemRect);
  137.                 CheckItem(popUpMenuH, menuItem, True);
  138.                 GetDItem(theDialog, dlgItem, itemKind, itemHandle, itemRect);  {get item clicked in}
  139.                 GetItem(popUpMenuH, menuItem, itemStr);
  140.                 SetIText(itemHandle, itemStr);
  141.                 DeleteMenu(menuID);  {trash the menu}
  142.                 case menuItem of
  143.                     patWhite: 
  144.                         gFillPat := white;
  145.                     patLtGray: 
  146.                         gFillPat := ltGray;
  147.                     patGray: 
  148.                         gFillPat := gray;
  149.                     patDkGray: 
  150.                         gFillPat := dkGray;
  151.                     patBlack: 
  152.                         gFillPat := black;
  153.                     otherwise
  154.                 end;  {case}
  155.             end;
  156.         ReleaseResource(Handle(popUpMenuH));
  157.         SetPort(savePort);
  158.     end;  {DoPopUp}
  159.  
  160.  
  161.     procedure GetInput (theDialog: DialogPtr);
  162.         var
  163.             itemKind: Integer;
  164.             itemHandle: Handle;
  165.             itemRect: Rect;
  166.             incrStr: Str255;
  167.             tempLong: Longint;
  168.     begin        {GetInput}
  169.         GetDItem(theDialog, incrItem, itemKind, itemHandle, itemRect);
  170.         GetIText(itemHandle, incrStr);
  171.         StringToNum(incrStr, tempLong);
  172.         gIncrement := tempLong;
  173.  
  174.         GetDItem(theDialog, durationItem, itemKind, itemHandle, itemRect);
  175.         GetIText(itemHandle, incrStr);
  176.         StringToNum(incrStr, tempLong);
  177.         gLoopEnd := tempLong;
  178.         if gLoopEnd <= 0 then
  179.             gLoopEnd := 1000;
  180.  
  181.         GetDItem(theDialog, ckBoxTicks, itemKind, itemHandle, itemRect);
  182.         gUseTicks := Boolean(GetCtlValue(ControlHandle(itemHandle)));
  183.         GetDItem(theDialog, ckBoxUseMsg, itemKind, itemHandle, itemRect);
  184.         gUseMsg := Boolean(GetCtlValue(ControlHandle(itemHandle)));
  185.         if gUseMsg then
  186.             begin
  187.                 GetDItem(theDialog, msgItem, itemKind, itemHandle, itemRect);
  188.                 GetIText(itemHandle, gMsg);
  189.             end;
  190.     end;        {GetInput}
  191.  
  192.  
  193.     function MainLoopFilter (theDialog: DialogPtr; var myEvent: EventRecord; var itemNumber: Integer): Boolean;
  194.         const
  195.             returnCode = $24;  {key codes to trap for. See IMV191 for proper codes}
  196.             enterCode = $34;
  197.             padEnterCode = $4C;
  198.         var
  199.             itemKind: Integer;
  200.             itemHandle: Handle;
  201.             itemRect: Rect;
  202.             keyCode, chCode: longInt;
  203.             ch: char;
  204.             cmdDown: boolean;
  205.     begin        {MainLoopFilter}
  206.         MainLoopFilter := False;
  207.         itemNumber := 0;
  208.         case myEvent.what of
  209.             keyDown: 
  210.                 begin
  211.                     MainLoopFilter := True;  {keeps us in MainLoopFilter}
  212.                     keyCode := BitAnd(myEvent.message, keyCodeMask);  {get the key code longint}
  213.                     keyCode := BitShift(keyCode, -8);  {get the first word of the key code}
  214.                     chCode := BitAnd(myEvent.message, charCodeMask);  {get the char code of the key pressed}
  215.                     ch := Chr(chCode);  {convert to character}
  216.                     cmdDown := (BitAnd(myEvent.modifiers, cmdKey) <> 0);  {is the command key down}
  217.                     if keyCode in [enterCode, padEnterCode] then
  218.                         itemNumber := quitItem {do OK button if above keys were pressed}
  219.                     else if not cmdDown then
  220.                         MainLoopFilter := False
  221.                     else
  222.                         begin
  223.                             case ch of
  224.                                 'q', 'Q': 
  225.                                     itemNumber := quitItem;
  226.                                 'b', 'B': 
  227.                                     itemNumber := barItem;
  228.                                 'p', 'P': 
  229.                                     itemNumber := pieItem;
  230.                                 't', 'T': 
  231.                                     begin
  232.                                         GetDItem(theDialog, ckBoxTicks, itemKind, itemHandle, itemRect);
  233.                                         if itemKind = chkCtrl + ctrlItem then
  234.                                             SetCtlValue(ControlHandle(itemHandle), 1 - GetCtlValue(ControlHandle(itemHandle)));        {set new control value}
  235.                                     end;
  236.                                 'u', 'U': 
  237.                                     begin
  238.                                         GetDItem(theDialog, ckBoxUseMsg, itemKind, itemHandle, itemRect);
  239.                                         if itemKind = chkCtrl + ctrlItem then
  240.                                             SetCtlValue(ControlHandle(itemHandle), 1 - GetCtlValue(ControlHandle(itemHandle)));        {set new control value}
  241.                                     end;
  242.                                 'a', 'A': 
  243.                                     itemNumber := aboutItem;
  244.                                 otherwise
  245.                             end;  {case ch of}
  246.                         end;
  247.                 end;        {keyDown}
  248.             activateEvt: 
  249.                 begin
  250.                     GetDItem(theDialog, menuItem, itemKind, itemHandle, itemRect);  {drop shadow of font dlg item}
  251.                     InsetRect(itemRect, -1, -1);
  252.                     FrameRect(itemRect);
  253.                     MoveTo(itemRect.botRight.h, itemRect.botRight.v);
  254.                     LineTo(itemRect.topLeft.h + 2, itemRect.botRight.v);
  255.                     MoveTo(itemRect.botRight.h, itemRect.botRight.v);
  256.                     LineTo(itemRect.botRight.h, itemRect.topLeft.v + 2);
  257.                 end;
  258.             otherwise
  259.         end;        {case myEvent.what}
  260.     end;        {MainLoopFilter}
  261.  
  262.  
  263.     procedure MainLoop;
  264.         const
  265.             DLOGID = 1001;
  266.         var
  267.             theDialog: DialogPtr;
  268.             quit: Boolean;
  269.             itemHit, saveLoopEnd: Integer;
  270.     begin        {MainLoop}
  271.         quit := False;
  272.         theDialog := GetNewDialog(DLOGID, nil, WindowPtr(-1));
  273.         SetPort(theDialog);
  274.         CenterWindow(theDialog);
  275.         ShowWindow(theDialog);
  276.         repeat
  277.             ModalDialog(@MainLoopFilter, itemHit);
  278.             case itemHit of
  279.                 quitItem: 
  280.                     quit := True;
  281.                 barItem, pieItem, aboutItem: 
  282.                     begin
  283.                         HideWindow(theDialog);
  284.                         GetInput(theDialog);
  285.                         ObscureCursor;
  286.                         if itemHit = barItem then
  287.                             if gUseMsg then
  288.                                 DoCBarTherm(gMsg)
  289.                             else
  290.                                 DoCBarTherm(Concat('This is a Bar Thermometer example.', Chr($0D), 'Press  - . (period) to cancel.'))
  291.                         else if itemHit = pieItem then
  292.                             if gUseMsg then
  293.                                 DoCPieTherm(gMsg)
  294.                             else
  295.                                 DoCPieTherm(Concat('This is a Pie Thermometer example.', Chr($0D), 'Press  - . (period) to cancel.'))
  296.                         else if itemHit = aboutItem then
  297.                             begin
  298.                                 saveLoopEnd := gLoopEnd;
  299.                                 gLoopEnd := 5000;
  300.                                 DoCBarTherm('Optional: Send beer money ($5 - $10) to Dan Rosman, 231 Charter Oak Circle, Walnut Creek, CA, 94596.');
  301.                                 gLoopEnd := saveLoopEnd;
  302.                             end;
  303.                         FlushEvents(mDownMask, 0);
  304.                         ShowWindow(theDialog);
  305.                     end;
  306.                 menuItem: 
  307.                     DoPopUp(theDialog, itemHit);
  308.                 ckBoxTicks, ckBoxUseMsg: 
  309.                     DoCheckBox(theDialog, itemHit);
  310.                 otherwise
  311.             end;        {case}
  312.         until quit;
  313.         DisposDialog(theDialog);
  314.     end;        {MainLoop}
  315.  
  316.  
  317. begin
  318.     InitGraf(@thePort);
  319.     InitFonts;
  320.     InitWindows;
  321.     InitMenus;
  322.     TEInit;
  323.     InitDialogs(nil);
  324.     InitCursor;
  325.  
  326.     gFillPat := gray;
  327.     gLoopEnd := 1000;
  328.     gUseTicks := False;
  329.     gUseMsg := False;
  330.  
  331.     MainLoop;
  332. end.